Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr48/ini_api.zip/INI_API.PAS

Pascal/Delphi Source File | 1993-06-15 | 13KB | 439 lines

{ ======================================================================= }
{ File: INI_API.PAS                                                       }
{ Description: Provides DOS Pascal programs with an .INI or .CFG file     }
{              handler comparable to the Windows 'Profile...' API         }
{              functions.                                                 }
{ Requirements: Comments MUST begin in column 1, cannot begin with a '['  }
{               and cannot contain an equals sign (at the moment).        }
{ Author: Thomas Hill, dba t.h.ink Software                               }
{ Revision History:                                                       }
{   Version 0.0 - First working version  6/03/93                          }
{   Version 1.0 - Cleaned up enough for public viewing.                   }
{                                                                         }
{ Synopsis: Currently reads the ENTIRE .INI (or .CFG, or whatever) file   }
{           into memory and creates a two tier structure of Section       }
{           titles and collections of 'entries' for each section.         }
{           All reads and updates act upon the in-memory image.           }
{           If the UpdateNow flag is set, any writes are immdeiately      }
{           save to disk, otherwise it is the programmer's responsibility }
{           to explicitly re-write the initialization file before ending. }
{ ======================================================================= }

unit INI_API;

interface

uses Strings;

{ Error enumeration types }
  type
      INIErrorType = (INI_NOERROR,INI_INVALID_FILE,INI_NO_FILE,INI_BAD_CREATE,
                      INI_BAD_WRITE,INI_BAD_READ);
  const
      INIErrorStr : array[0..5] of pChar =
                    ('INI File: No Error','INI File: Invalid File',
                     'INI File: File Not Found','INI File: Cannot Create File',
                     'INI File: Cannot write File','INI File: Cannot Read File');

{ Write data to a .INI file. Returns TRUE if successful }
  function WriteProfileString(Section : pChar; { section: [section] }
                              Entry : pChar;   { entry:   entry=data }
                              Data : pChar) : boolean;

{ get data associated with 'entry', under 'section'. }
{ Returns data in 'Target', or places 'Default' in target, if entry/section }
{ is not found. }
  function ReadProfileString(Section : pChar;
                             Entry : pChar;
                             Default : pChar;  { default value if Entry not found }
                             Target : pChar;   { where to put the answer }
                             ByteCnt : integer { size of target buffer }
                             ) : boolean;

{ Deletes entry under 'section' title.  Returns FALSE if delete failed }
 function DeleteProfileString(Section : pChar;
                              Entry : pChar
                              ) : boolean;

{Explicitly read and write the INI file }
  procedure ReadINIFile(Name : pChar);
  procedure WriteINIFile(Name : pChar);

{ Display to screen or print the current INI file }
  procedure DisplayINIFile;
  procedure PrintINIFile;

{ Status and initialization routines }
function INI_GetUpdateFlag : boolean;  { current setting of UpdateNow flag }
procedure INI_SetUpdateFlag(F : boolean);  { Change UpdateNow flag }

implementation

  uses Objects;

  const
       Dirty : boolean = FALSE;
       Open : boolean = FALSE;
       UpdateNow : boolean = FALSE;

  type
      pEntryObj = ^tEntryObj;
      tEntryObj = object(tObject)
                    Entry : pChar;
                    Data : pChar;
                    constructor Init(E,D : string);
                    destructor Done; virtual;
                  end;

      pEntryList = ^tEntryList;
      tEntryList = object(tSortedCollection)
                     function KeyOf(Item : pointer) : pointer; virtual;
                     function Compare(Key1,Key2 : pointer) : integer; virtual;
                   end;

      pSectionObj = ^tSectionObj;
      tSectionObj = object(tObject)
                      Section : pChar;
                      EList : tEntryList;
                      constructor Init(S : string);
                      destructor Done; virtual;
                    end;

      pSectionList = ^tSectionList;
      tSectionList = object(tSortedCollection)
                     function KeyOf(Item : pointer) : pointer; virtual;
                     function Compare(Key1,Key2 : pointer) : integer; virtual;
                   end;


  var
     INIFile : text;
     INIFName : pChar;
     LineBuf : string;
     INIList : tSectionList;
     Output : text;

  constructor tEntryObj.Init;

    begin
      getmem(Entry,length(E)+1); StrPCopy(Entry,E);
      getmem(Data,length(D)+1); StrPCopy(Data,D);
    end;

  destructor tEntryObj.Done;

    begin
      freemem(Entry,strlen(Entry)+1);
      freemem(Data,strlen(Data)+1);
      inherited Done;
    end;

  constructor tSectionObj.Init;

    begin
      getmem(Section,length(S)+1); StrPCopy(Section,S);
      EList.Init(10,4);
    end;

  destructor tSectionObj.Done;

    begin
      freemem(Section,strlen(Section)+1);
      EList.FreeAll;
      inherited Done;
    end;

  function tEntryList.KeyOf(Item : pointer) : pointer;

    begin
      KeyOf := pChar(pEntryObj(Item)^.Entry);
    end;

  function tEntryList.Compare(Key1,Key2 : pointer) : integer;

    begin
      Compare := strcomp(pChar(Key1),pChar(Key2));
    end;

  function tSectionList.KeyOf(Item : pointer) : pointer;

    begin
      KeyOf := pChar(pSectionObj(Item)^.Section);
    end;

  function tSectionList.Compare(Key1,Key2 : pointer) : integer;

    begin
      Compare := strcomp(pChar(Key1),pChar(Key2));
    end;

  procedure LTrim(var S : string);

    var
       i : integer;

    begin
      i := 1;
      repeat
        if S[i] = ' ' then delete(S,i,1);
      until S[i] <> ' ' ;
    end;

  procedure RTrim(var S : string);

    var
       i : integer;

    begin
      i := length(S);
      while S[i] = ' ' do dec(i);
      S[0] := chr(i);
    end;

  procedure ReadINIFile(Name : pChar);

    var
      CurSection : pSectionObj;
      CurEntry : pEntryObj;
      SecStr : string;
      EntryStr : string;
      DataStr : string;
      i,j : integer;

    begin
      IniList.Init(100,20);
      getmem(INIFName,strlen(Name) + 1);
      StrCopy(INIFName,Name);
      assign(INIFile,Name); {$I-} reset(INIFile); {$I+}
      if IOResult = 0 then
      begin
        CurSection := nil;
        repeat
          readln(INIFile,LineBuf);
          if (length(LineBuf) > 0) then
          begin
            if pos('[',LineBuf) = 1 then
            begin
              if CurSection <> nil then INIList.Insert(CurSection);
              SecStr := Copy(LineBuf,2,pos(']',LineBuf)-2);
              CurSection := new(pSectionObj,Init(SecStr));
            end
            else
            begin
              i := pos('=',LineBuf);
              if i > 0 then
              begin
                EntryStr := Copy(LineBuf,1,i - 1);
                LTRim(EntryStr); RTrim(EntryStr);
                DataStr := Copy(LineBuf,i + 1,length(LineBuf));
                LTrim(DataStr); RTrim(DataStr);
                if length(DataStr) = 0 then DataStr := '  ';
              end
              else
              begin
                EntryStr := LineBuf;
                LTrim(EntryStr); RTrim(EntryStr);
                DataStr := '';
              end;
              CurEntry := new(pEntryObj,Init(EntryStr,DataStr));
              CurSection^.EList.Insert(CurEntry);
            end;
          end;
        until EOF(INIFile);
        INIList.Insert(CurSection);
        close(INIFile);
      end
      else
      begin
        rewrite(INIFile);
      end;
    end;

  procedure ShowEntries(List : tEntryList);

    procedure ShowEntry(Item : pointer); far;

      begin
        writeln(Output,pEntryObj(Item)^.Entry,'=',pEntryObj(Item)^.Data);
      end;

    begin
      List.ForEach(@ShowEntry);
    end;

  procedure ShowINIFile;

    procedure SHowSection(Item : pointer); far;

      begin
        writeln(Output,'[',pSectionObj(Item)^.Section,']');
        ShowEntries(pSectionObj(Item)^.EList);
      end;

    begin
      IniList.ForEach(@ShowSection);
    end;

{ Write data to a .INI file. Returns TRUE if successful }
  function WriteProfileString(Section : pChar; { section: [section] }
                              Entry : pChar;   { entry:   entry=data }
                              Data : pChar) : boolean;

    var
       SObj : pSectionObj;
       EObj : pEntryObj;
       SIndex,
       EIndex : integer;

    begin
      if INIFName = nil then
      begin
        WriteProfileString := FALSE;
        exit;
      end;
      SObj := new(pSectionObj,Init(StrPas(Section)));
      EObj := new(pEntryObj,Init(StrPas(Entry),StrPas(Data)));
      if INIList.Search(Section,SIndex) then  { find section title }
      begin
        SObj := pSectionObj(INIList.At(SIndex));
        if SObj^.EList.Search(Entry,EIndex) then  { find entry }
        begin
          EObj := pEntryObj(SObj^.EList.At(Eindex));
          StrPCopy(EObj^.Data,StrPas(Data));
          SObj^.EList.AtPut(EIndex,EObj);
        end
        else
        begin
          SObj^.EList.Insert(Eobj);
        end;
      end
      else
      begin
        INIList.Insert(SObj);
        SObj^.Elist.Insert(EObj);
      end;
      Dirty := TRUE;
      if UpdateNow then WriteINIFile(INIFName);
      WriteProfileString := TRUE;
    end;

{ get data associated with 'entry', under 'section' }
{ Returns data in 'Target', or places 'Default' in target, if entry/section }
{ is not found. }
  function ReadProfileString(Section : pChar;
                             Entry : pChar;
                             Default : pChar;  { default value if Entry not found }
                             Target : pChar;   { where to put the answer }
                             ByteCnt : integer { size of target buffer }
                             ) : boolean;

    var
       SObj : pSectionObj;
       EObj : pEntryObj;
       SIndex,EIndex : integer;
       Result : pChar;

    begin
      if INIFName = nil then
      begin
        ReadProfileString := FALSE;
        exit;
      end;
      if target = nil then getmem(Target,ByteCnt);
      if INIList.Search(Section,SIndex) then
      begin
        SObj := pSectionObj(INIList.At(SIndex));
        if SObj^.Elist.Search(Entry,EIndex) then
        begin
          EObj := pEntryObj(SObj^.Elist.At(EIndex));
          StrCopy(Target,EObj^.Data);
          ReadProfileString := TRUE;
        end
        else
        begin
          StrCopy(target,Default);
          ReadProfileString := FALSE;
        end;
      end
      else
      begin
         StrCopy(Target,Default);
        ReadPRofileString := FALSE;
      end;
    end;

  function DeleteProfileString(Section : pChar;
                               Entry : pChar
                               ) : boolean;

    var
       SObj : pSectionObj;
       EObj : pEntryObj;
       SIndex,Eindex : integer;

    begin
      if INIList.Search(Section,SIndex) then
      begin
        SObj := pSectionObj(INIList.At(Sindex));
        if SObj^.EList.Search(Entry,EIndex) then
        begin
          SObj^.EList.AtFree(EIndex);
          DeletePRofileString := TRUE;
          Dirty := TRUE;
          if UpdateNow then WriteINIFile(INIFName);
        end
        else
        begin
          DeleteProfileString := FALSE;
        end;
      end
      else
      begin
        DeleteProfileString := FALSE;
      end;
    end;



  procedure WriteINIFile;

    begin
      assign(OutPut,Name);
      rewrite(Output);
      ShowINIFile;
      close(Output);
      Dirty := FALSE;
    end;

  procedure DisplayINIFile;

    begin
      assign(Output,'CON'); Rewrite(OutPut);
      ShowINIFile;
    end;

  procedure PrintINIFile;

    begin
      assign(Output,'LPT1'); rewrite(Output);
      ShowINIFile;
      writeln(Output,^L);
    end;

  function INI_GetUpdateFlag : boolean;

    begin
      INI_GetUpdateFlag := UpdateNow;
    end;

  procedure INI_SetUpdateFlag;

    begin
      UpdateNow := F;
    end;

begin
  INIFName := nil;
end.